home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vb4comms / dwdcb.cls < prev    next >
Text File  |  1996-03-25  |  10KB  |  352 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "dwDCB"
  6. Attribute VB_Creatable = True
  7. Attribute VB_Exposed = False
  8. ' dwDCB - Device Communication Block utility class
  9. ' Part of the Desaware API Class Library
  10. ' Copyright (c) 1996 by Desaware.
  11. ' All Rights Reserved
  12. Option Explicit
  13.  
  14. Private Type dcbType    ' Win32API.TXT is incorrect here.
  15.         DCBlength As Long
  16.         BaudRate As Long
  17.         Bits1 As Long
  18.         wReserved As Integer
  19.         XonLim As Integer
  20.         XoffLim As Integer
  21.         ByteSize As Byte
  22.         Parity As Byte
  23.         StopBits As Byte
  24.         XonChar As Byte
  25.         XoffChar As Byte
  26.         ErrorChar As Byte
  27.         EofChar As Byte
  28.         EvtChar As Byte
  29.         wReserved2 As Integer
  30. End Type
  31.  
  32. Private DCB As dcbType
  33. Private BufferSize As Integer
  34.  
  35. Private Const ERR_INVALIDPROPERTY = 31000
  36. Private Const CLASS_NAME$ = "dwDCB"
  37.  
  38. Private Const FLAG_fBinary& = &H1
  39. Private Const FLAG_fParity& = &H2
  40. Private Const FLAG_fOutxCtsFlow = &H4
  41. Private Const FLAG_fOutxDsrFlow = &H8
  42. Private Const FLAG_fDtrControl = &H30
  43. Private Const FLAG_fDsrSensitivity = &H40
  44. Private Const FLAG_fTXContinueOnXoff = &H80
  45. Private Const FLAG_fOutX = &H100
  46. Private Const FLAG_fInX = &H200
  47. Private Const FLAG_fErrorChar = &H400
  48. Private Const FLAG_fNull = &H800
  49. Private Const FLAG_fRtsControl = &H3000
  50. Private Const FLAG_fAbortOnError = &H4000
  51.  
  52. Private Declare Function apiSetCommState Lib "kernel32" Alias "SetCommState" (ByVal hCommDev As Long, lpDCB As dcbType) As Long
  53. Private Declare Function apiGetCommState Lib "kernel32" Alias "GetCommState" (ByVal nCid As Long, lpDCB As dcbType) As Long
  54.  
  55.  
  56. Private Sub Class_Initialize()
  57.     ' The structure length must always be set
  58.     DCB.DCBlength = Len(DCB)
  59.     ' Set some default values
  60.     BufferSize = 2048
  61.     fParity = False
  62.     fOutxCtsFlow = True
  63.     fOutxDsrFlow = True
  64.     fDtrControl = 1
  65.     fDsrSensitivity = True
  66.     fTXContinueOnXoff = True
  67.     fOutX = True
  68.     fInX = True
  69.     fErrorChar = True
  70.     fNull = True
  71.     fRtsControl = 1
  72.     fAbortOnError = True
  73.     DCB.XonLim = 100
  74.     DCB.XoffLim = BufferSize - 100
  75.     DCB.ByteSize = 8
  76.     DCB.Parity = 0
  77.     DCB.StopBits = 0
  78.     DCB.XonChar = 17
  79.     DCB.XoffChar = 19
  80.     DCB.ErrorChar = Asc("~")
  81.     DCB.EofChar = 26 ' ^Z
  82.     DCB.EvtChar = 255
  83.     ' Set some default value
  84.     DCB.BaudRate = 2400
  85. End Sub
  86.  
  87.  
  88. Public Property Get BaudRate() As Long
  89.     BaudRate = DCB.BaudRate
  90. End Property
  91.  
  92.  
  93. Public Property Let BaudRate(vNewValue As Long)
  94.     Select Case vNewValue
  95.         Case 110, 300, 600, 1200, 2400, 4800, 9600, 14400, 19200, 38400, 56000, 57600, 115200, 128000, 256000
  96.             DCB.BaudRate = vNewValue
  97.         Case Else
  98.             Err.Raise vbObjectError + ERR_INVALIDPROPERTY, CLASS_NAME, "Invalid baud rate"
  99.     End Select
  100. End Property
  101.  
  102.  
  103. Public Property Get fParity() As Boolean
  104.     If DCB.Bits1 And FLAG_fParity Then
  105.         fParity = True
  106.     End If
  107. End Property
  108.  
  109. Public Property Let fParity(vNewValue As Boolean)
  110.     DCB.Bits1 = DCB.Bits1 And (Not FLAG_fParity)
  111.     If vNewValue Then DCB.Bits1 = DCB.Bits1 Or FLAG_fParity
  112. End Property
  113.  
  114. Public Property Get fOutxCtsFlow() As Boolean
  115.     If DCB.Bits1 And FLAG_fOutxCtsFlow Then
  116.         fOutxCtsFlow = True
  117.     End If
  118. End Property
  119.  
  120. Public Property Let fOutxCtsFlow(vNewValue As Boolean)
  121.     DCB.Bits1 = DCB.Bits1 And (Not FLAG_fOutxCtsFlow)
  122.     If vNewValue Then DCB.Bits1 = DCB.Bits1 Or FLAG_fOutxCtsFlow
  123. End Property
  124.  
  125. Public Property Get fOutxDsrFlow() As Boolean
  126.     If DCB.Bits1 And FLAG_fOutxDsrFlow Then
  127.         fOutxDsrFlow = True
  128.     End If
  129. End Property
  130.  
  131. Public Property Let fOutxDsrFlow(vNewValue As Boolean)
  132.     DCB.Bits1 = DCB.Bits1 And (Not FLAG_fOutxDsrFlow)
  133.     If vNewValue Then DCB.Bits1 = DCB.Bits1 Or FLAG_fOutxDsrFlow
  134. End Property
  135.  
  136. Public Property Get fDtrControl() As Integer
  137.     Dim ival&
  138.     ival = DCB.Bits1 And FLAG_fDtrControl
  139.     fDtrControl = ival \ 16    ' Shift right 4 bits
  140. End Property
  141.  
  142. ' 0 to disable, 1 to enable, 2 for handshake mode
  143. Public Property Let fDtrControl(vNewValue As Integer)
  144.     If vNewValue < 0 Or vNewValue > 2 Then
  145.         Err.Raise vbObjectError + ERR_INVALIDPROPERTY, CLASS_NAME, "Invalid fDtrControl setting"
  146.     End If
  147.     DCB.Bits1 = DCB.Bits1 And FLAG_fDtrControl
  148.     DCB.Bits1 = DCB.Bits1 Or (vNewValue * 16)
  149. End Property
  150.  
  151. Public Property Get fDsrSensitivity() As Boolean
  152.     If DCB.Bits1 And FLAG_fDsrSensitivity Then
  153.         fDsrSensitivity = True
  154.     End If
  155. End Property
  156.  
  157. Public Property Let fDsrSensitivity(vNewValue As Boolean)
  158.     DCB.Bits1 = DCB.Bits1 And (Not FLAG_fDsrSensitivity)
  159.     If vNewValue Then DCB.Bits1 = DCB.Bits1 Or FLAG_fDsrSensitivity
  160. End Property
  161.  
  162.  
  163. Public Property Get fTXContinueOnXoff() As Boolean
  164.     If DCB.Bits1 And FLAG_fTXContinueOnXoff Then
  165.         fTXContinueOnXoff = True
  166.     End If
  167. End Property
  168.  
  169. Public Property Let fTXContinueOnXoff(vNewValue As Boolean)
  170.     DCB.Bits1 = DCB.Bits1 And (Not FLAG_fTXContinueOnXoff)
  171.     If vNewValue Then DCB.Bits1 = DCB.Bits1 Or FLAG_fTXContinueOnXoff
  172. End Property
  173.  
  174. Public Property Get fOutX() As Boolean
  175.     If DCB.Bits1 And FLAG_fOutX Then
  176.         fOutX = True
  177.     End If
  178. End Property
  179.  
  180. Public Property Let fOutX(vNewValue As Boolean)
  181.     DCB.Bits1 = DCB.Bits1 And (Not FLAG_fOutX)
  182.     If vNewValue Then DCB.Bits1 = DCB.Bits1 Or FLAG_fOutX
  183. End Property
  184.  
  185. Public Property Get fInX() As Boolean
  186.     If DCB.Bits1 And FLAG_fInX Then
  187.         fInX = True
  188.     End If
  189. End Property
  190.  
  191. Public Property Let fInX(vNewValue As Boolean)
  192.     DCB.Bits1 = DCB.Bits1 And (Not FLAG_fInX)
  193.     If vNewValue Then DCB.Bits1 = DCB.Bits1 Or FLAG_fInX
  194. End Property
  195.  
  196. Public Property Get fErrorChar() As Boolean
  197.     If DCB.Bits1 And FLAG_fErrorChar Then
  198.         fErrorChar = True
  199.     End If
  200. End Property
  201.  
  202. Public Property Let fErrorChar(vNewValue As Boolean)
  203.     DCB.Bits1 = DCB.Bits1 And (Not FLAG_fErrorChar)
  204.     If vNewValue Then DCB.Bits1 = DCB.Bits1 Or FLAG_fErrorChar
  205. End Property
  206.  
  207. Public Property Get fNull() As Boolean
  208.     If DCB.Bits1 And FLAG_fNull Then
  209.         fNull = True
  210.     End If
  211. End Property
  212.  
  213. Public Property Let fNull(vNewValue As Boolean)
  214.     DCB.Bits1 = DCB.Bits1 And (Not FLAG_fNull)
  215.     If vNewValue Then DCB.Bits1 = DCB.Bits1 Or FLAG_fNull
  216. End Property
  217.  
  218. Public Property Get fRtsControl() As Integer
  219.     Dim ival&
  220.     ival = DCB.Bits1 And FLAG_fRtsControl
  221.     fRtsControl = ival \ &H1000    ' Shift right 4 bits
  222. End Property
  223.  
  224. Public Property Let fRtsControl(vNewValue As Integer)
  225.     If vNewValue < 0 Or vNewValue > 3 Then
  226.         Err.Raise vbObjectError + ERR_INVALIDPROPERTY, CLASS_NAME, "Invalid fRtsControl setting"
  227.     End If
  228.     DCB.Bits1 = DCB.Bits1 And FLAG_fRtsControl
  229.     DCB.Bits1 = DCB.Bits1 Or (vNewValue * &H1000)
  230. End Property
  231.  
  232. Public Property Get fAbortOnError() As Boolean
  233.     If DCB.Bits1 And FLAG_fAbortOnError Then
  234.         fAbortOnError = True
  235.     End If
  236. End Property
  237.  
  238. Public Property Let fAbortOnError(vNewValue As Boolean)
  239.     DCB.Bits1 = DCB.Bits1 And (Not FLAG_fAbortOnError)
  240.     If vNewValue Then DCB.Bits1 = DCB.Bits1 Or FLAG_fAbortOnError
  241. End Property
  242.  
  243. Public Property Get XonLim() As Integer
  244.     XonLim = DCB.XonLim
  245. End Property
  246.  
  247. Public Property Let XonLim(vNewValue As Integer)
  248.     DCB.XonLim = vNewValue
  249. End Property
  250.  
  251. Public Property Get XoffLim() As Integer
  252.     XoffLim = DCB.XoffLim
  253. End Property
  254.  
  255. Public Property Let XoffLim(vNewValue As Integer)
  256.     DCB.XoffLim = vNewValue
  257. End Property
  258.  
  259. Public Property Get ByteSize() As Byte
  260.     ByteSize = DCB.ByteSize
  261. End Property
  262.  
  263. Public Property Let ByteSize(vNewValue As Byte)
  264.     If vNewValue < 4 Or vNewValue > 8 Then
  265.         Err.Raise vbObjectError + ERR_INVALIDPROPERTY, CLASS_NAME, "Invalid Byte size setting"
  266.     End If
  267.     DCB.ByteSize = vNewValue
  268. End Property
  269.  
  270.  
  271. Public Property Get Parity() As Byte
  272.     Parity = DCB.Parity
  273. End Property
  274.  
  275. ' 0 - 4 = No, odd, even, mark, space
  276. Public Property Let Parity(vNewValue As Byte)
  277.     If vNewValue < 0 Or vNewValue > 4 Then
  278.         Err.Raise vbObjectError + ERR_INVALIDPROPERTY, CL